(define-module www.contcgi2
  (use text.tree)
  (use text.html-lite)
  (use file.util)
  (use www.cgi)
  (use www.fastcgi)
  (export show action contcgi-main))
(select-module www.contcgi2)

;;Kimura Fuyuki氏の、Gauche-fastcgiのコードが参考になりました。
;;ありがとうございます。

;;www.fastcgiモジュールでexportされていない関数で、必要なものがあるから、取り出す。
(define fcgx-is-cgi (with-module www.fastcgi fcgx-is-cgi))

;継続サーバの肝である継続を保存するハッシュテーブル。
(define cont-table (make-hash-table 'eq?))
;;継続を保存するたびにインクリメントすることで、一意なidを継続に割り当てる。
(define kurl 0)
;;大域脱出用。
(define return #f)

;;file-mtimeでスクリプトの更新を検知する。検知したら、エラーページを表示しつつ、fastcgiプロセスを再起動するようにしてある。
(define script-modified? #f)
(define (make-modified? path)
  (let1 initial-mtime (file-mtime path)
    (lambda ()
      (not (file-mtime=? path initial-mtime)))))

;;cont-tableハッシュテーブルに見つからないkeyが、CGIパラメータkurlで指定された場合の、エラーページ
(define (error-page params)
  `(,(cgi-header)
    ,(html-doctype)
    ,(html:html
      (html:head (html:title "error"))
      (html:body
       (html:p "You gave an invalid value on 'kurl'.")
       (html:p "Please restart the script from "  
	       (html:a :href (cgi-get-metavariable "SCRIPT_NAME") "here"))
       (html:p (html:b "pid = " (sys-getpid)))
       ;;CGIにあたえられたパラメータをhtml:tableの一覧にして表示。
       (html:table
	:border 1
	(html:tr (html:th "Name") (html:th "Value"))
	(map (lambda (p)
	       (html:tr
		(html:td (html-escape-string (car p)))
		(html:td (html-escape-string (x->string (cdr p))))))
	     params))))))

;;一時的にactionをこのリストにためておく。showで使ったあと、また空リストにset!することになっている。
(define actions-list '())

;;actions-listにCPSなprocを追加するとともに、その継続への一意なidを返す。
(define (action proc)
  (begin0
   (+ kurl (length actions-list))
   (set! actions-list (cons proc actions-list))))

(define (show tree)
  (call/cc
   (lambda (cc)
     (for-each (lambda (p)
		 (hash-table-put! cont-table kurl (lambda (params) (cc (p params))))
		 (inc! kurl))
	       (reverse actions-list))
     (set! actions-list '())
     (return `(,(cgi-header)
	       ,(html-doctype)
	       ,tree)))))

(define (contcgi-main proc)
  (define (body params)
    (let ((key (cgi-get-parameter "kurl" params :default #f :convert x->number)))
      (call/cc (lambda (cc)
		 (set! return cc)
		 (cond
		  ((script-modified?) (error "Maybe you modified the script file"))
		  ;;foo.fcgi?kurl=1などなら、継続を呼び出す。
		  (key ((hash-table-get cont-table key error-page) params))
		  ;;foo.fcgiなら、メインロジックであるprocを呼び出す。
		  (else (proc params)))))))
  (define (debug-loop)
    (cgi-main body)
    (debug-loop))

  (set! script-modified? (make-modified? (with-module user *program-name*)))
    ;;端末からの実行なら、インタラクティブなデバッグに入る。
  (when (fcgx-is-cgi)
    (set-signal-handler! SIGINT (lambda (n) (display "Received SIGINT\n" (current-error-port)) (exit 1)))
    (debug-loop))

  (with-fastcgi
   (lambda () (cgi-main body :on-error (cut raise)))))

(provide "www/contcgi2")
